perm filename VECTOR.SAI[SYS,HE] blob
sn#004170 filedate 1972-06-20 generic text, type T, neo UTF8
00100 REQUIRE "VECT[SYS,HE]" LOAD_MODULE;
00200 EXTERNAL SIMPLE PROCEDURE SCALE(REAL ARRAY R,A;REAL V);
00300 EXTERNAL SIMPLE PROCEDURE DIFFERENCE(REAL ARRAY R,A,B);
00400 EXTERNAL REAL SIMPLE PROCEDURE DOT(REAL ARRAY R,A);
00500 EXTERNAL SIMPLE PROCEDURE CROSS(REAL ARRAY R,A,B);
00600 EXTERNAL REAL SIMPLE PROCEDURE MAGNITUDE(REAL ARRAY R);
00700 EXTERNAL SIMPLE PROCEDURE UNIT(REAL ARRAY R,A);
00800 EXTERNAL SIMPLE PROCEDURE MOVEV(REAL ARRAY R,A);
00900 EXTERNAL SIMPLE PROCEDURE INVERT(REAL ARRAY T,R);
01000 EXTERNAL SIMPLE PROCEDURE IDENTITY(REAL ARRAY A);
01100 EXTERNAL SIMPLE PROCEDURE TIMES(REAL ARRAY R,A,B);
01200 EXTERNAL SIMPLE PROCEDURE PLUS(REAL ARRAY R,A,B);
01300 EXTERNAL SIMPLE PROCEDURE REDUCE(REAL ARRAY R);
01400 EXTERNAL SIMPLE PROCEDURE TRANSFORM(REAL ARRAY R,T,V);
01500 EXTERNAL SIMPLE PROCEDURE TRANSPOSE(REAL ARRAY R,A);
01600 EXTERNAL SIMPLE PROCEDURE RESET(REAL ARRAY R);
01700 EXTERNAL SIMPLE PROCEDURE MOVET(REAL ARRAY R,A);
01800 EXTERNAL SIMPLE PROCEDURE NORMALIZE(REAL ARRAY R,A);
01900 EXTERNAL REAL SIMPLE PROCEDURE INNER(REAL ARRAY A,B);
02000 REQUIRE "SAITRG[SYS,HE]" SOURCE_FILE;
02050 REQUIRE "UNDER[SYS,HE]" LOAD_MODULE;
02075 EXTERNAL SIMPLE PROCEDURE UNDERFLOW(INTEGER I);
02100
02200 DEFINE CRLF="'15&'12";
02300 DEFINE RAD="57.29577951";
02400 DEFINE PI="3.1415926535",PIBY2="1.5707963268",TPI="6.2831853070";
02500 SIMPLE PROCEDURE ROTATE(SAFE REAL ARRAY P,A,O;REAL TH);
02600 BEGIN SAFE OWN REAL ARRAY T[1:4];
02700 CROSS(T,O,A);
02710 UNIT(T,T);
02800 SCALE(T,T,MAGNITUDE(A)*SIND(TH));
02900 MOVEV(P,A);
03000 SCALE(P,P,COSD(TH));
03100 PLUS(P,P,T) END;
03200
03300 REAL SIMPLE PROCEDURE ANGLE(SAFE REAL ARRAY P,A,O);
03400 BEGIN SAFE OWN REAL ARRAY T[1:4];
03500 CROSS(T,A,P);
03600 RETURN(RAD*ATAN2(DOT(O,T),DOT(A,P))) END;
03700
03800 INTEGER FORMAT_POINTER; SAFE INTEGER ARRAY FORMAT_STACK[0:5,0:1];
03900 SIMPLE PROCEDURE POP_FORMAT;
04000 IF FORMAT_POINTER ≥ 0 THEN BEGIN
04100 SETFORMAT(FORMAT_STACK[FORMAT_POINTER,0],FORMAT_STACK[FORMAT_POINTER,1]);
04200 FORMAT_POINTER←FORMAT_POINTER-1
04300 END ELSE SETFORMAT(0,8);
04400
04500 SIMPLE PROCEDURE PUSH_FORMAT(INTEGER W,D);
04600 BEGIN FORMAT_POINTER←FORMAT_POINTER+1;
04700 GETFORMAT(FORMAT_STACK[FORMAT_POINTER,0],FORMAT_STACK[FORMAT_POINTER,1]);
04800 SETFORMAT(W,D)
04900 END;
05000
05100 SIMPLE PROCEDURE PVECT(STRING S;REAL ARRAY V);
05200 BEGIN INTEGER I;
05300 PUSH_FORMAT(7,2);
05400 OUTSTR(S);
05500 FOR I←1 STEP 1 UNTIL 4 DO OUTSTR(CVF(V[I]));
05600 OUTSTR(CRLF);
05700 POP_FORMAT;
05800 END;
05900
06000 SIMPLE PROCEDURE PMAT(STRING S;REAL ARRAY T);
06100 BEGIN INTEGER I,J;
06200 PUSH_FORMAT(7,2);
06300 OUTSTR(S&CRLF);
06400 FOR I←1 STEP 1 UNTIL 4 DO BEGIN
06500 FOR J←1 STEP 1 UNTIL 4 DO OUTSTR(CVF(T[I,J]));
06600 OUTSTR(CRLF);
06700 END;
06800 OUTSTR(CRLF);
06900 POP_FORMAT;
07000 END;
07100
07200 SIMPLE PROCEDURE CVV(REAL ARRAY R,A;INTEGER I);
07300 BEGIN INTEGER K;
07400 FOR K←1 STEP 1 UNTIL 3 DO R[K]←A[K,I];
07500 R[4]←1.0;
07600 END;
07700
07800 SIMPLE PROCEDURE CVC(REAL ARRAY A;INTEGER I;REAL ARRAY R);
07900 BEGIN INTEGER K;
08000 FOR K←1 STEP 1 UNTIL 3 DO A[K,I]←R[K];
08100 END;
08200